*
* $Id$
*
* $Log: dzsnap.F,v $
* Revision 1.1.1.1  2002/06/16 15:18:48  hristov
* Separate distribution  of Geant3
*
* Revision 1.1.1.1  1999/05/18 15:55:22  fca
* AliRoot sources
*
* Revision 1.2  1996/04/24 17:26:15  mclareni
* Extend the include file cleanup to dzebra, rz and tq, and also add
* dependencies in some cases.
*
* Revision 1.1.1.1  1996/03/06 10:47:07  mclareni
* Zebra
*
*
*-----------------------------------------------------------
#include "zebra/pilot.h"
#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
#include "zebra/debugvf1.inc"
#endif
      SUBROUTINE DZSNAP (CHTEXT,IXDIV,CHOPT)
#include "zebra/mqsys.inc"
#include "zebra/qequ.inc"
#include "zebra/mzcn.inc"
#include "zebra/zbcdch.inc"
#include "zebra/zbcdk.inc"
#include "zebra/zmach.inc"
#include "zebra/zstate.inc"
#include "zebra/zunit.inc"
#include "zebra/dzc1.inc"
#include "zebra/bankparq.inc"
#include "zebra/divparq.inc"
#include "zebra/questparq.inc"
#include "zebra/storparq.inc"
      CHARACTER *(*) CHTEXT,CHOPT

      CHARACTER CHROUT*(*)
      PARAMETER (CHROUT = 'DZSNAP')

#include "zebra/q_jbit.inc"
#include "zebra/q_jbyt.inc"

#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
#include "zebra/debugvf2.inc"
#endif

      CQSTAK = CHROUT//'/'
      IQUEST(1) = 0
      IF (CHTEXT.NE.CDUMMQ)                                THEN
          CQMAP(1)          = ' '
          CQMAP(2)(1:12)    = ' DZSNAP --- '
          CQMAP(2)(13:100)  = CHTEXT
          CQMAP(2)(101:110) = 'OPTIONS : '
          CQMAP(2)(111:130) = CHOPT
          CALL DZTEXT(0,CDUMMQ,2)
      ENDIF

      CALL DZOPT(CHOPT)


      CALL MZSDIV(IXDIV,0)

      CQMAP(1) = ' '
      CQMAP(2) = '   NAME       LQSTOR NQSTRU  NQREF NQLINK '//
     X           'LQMINR LQ2END JQDVLL JQDVSY NQFEND  LOW-1  LOW-N '//
     X           'HIGH-1 HIGH-N SYST-1 SYST-N    END'
#if defined(CERNLIB_OCTMAP)
      WRITE(CQMAP(3),'(2X,2A4,''('',O8,'')'',15I7)')
#endif
#if !defined(CERNLIB_OCTMAP)
      WRITE(CQMAP(3),'(2X,2A4,''('',Z8,'')'',15I7)')
#endif
     W  NQSNAM(1)     , NQSNAM(2) ,
*  Map  addresses expressed in machine words
#if defined(CERNLIB_WORDMAP)
     W  LQSTOR+1 ,
*  Map addresses expressed in bytes
#endif
#if !defined(CERNLIB_WORDMAP)
     W  (LQSTOR+1)*4 ,
#endif
     W  NQSTRU , NQREF    , NQLINK , NQMINR        ,
     W  LQ2END , JQDVLL   , JQDVSY , NQFEND        ,
     W  LQSTA (KQT+MDVLWQ),LQEND (KQT+MDVLWQ)-1    ,
     W  LQSTA (KQT+MDVHGQ),LQEND (KQT+MDVHGQ)-1    ,
     W  LQSTA (KQT+JQDVSY),LQEND (KQT+JQDVSY)-1    ,
     W  LQSTA (KQT+NDVMXQ+1)-1

      CALL DZTEXT(0,CDUMMQ,3)



      DO 100 IFENCE=-NQFEND+1,0
          IF(LQ(KQS+IFENCE).NE.IQNIL)      THEN
              WRITE (CQINFO,'(I5,1X,Z16)') IFENCE,LQ(KQS+IFENCE)
              CALL DZTEXT(MSNA1Q,CDUMMQ,0)
              IF (IFLOPT(MPOSSQ).NE.0)                     GO TO 998
          ENDIF
  100 CONTINUE


      IF ((LQ(KQS+LQSTA(KQT+21)+1).NE.IQNIL) .OR.
     X    (LQ(KQS+LQSTA(KQT+21)+2).NE.IQNIL)      ) THEN
          WRITE (CQINFO,'(Z16,1X,Z16)')
     X    LQ(KQS+LQSTA(KQT+21)+1),LQ(KQS+LQSTA(KQT+21)+2)
          CALL DZTEXT(MSNA2Q,CDUMMQ,0)
          IF (IFLOPT(MPOSSQ).NE.0)                         GO TO 998
      ENDIF

      IF(NQSTRU.GT.NQREF)              THEN
          WRITE (CQINFO,'(I8,''>'',I8)') NQSTRU,NQREF
          CALL DZTEXT(MSNA3Q,CDUMMQ,0)
          IF (IFLOPT(MPOSSQ).NE.0)                         GO TO 998
      ENDIF

      IF(NQREF.GT.NQLINK)              THEN
          WRITE (CQINFO,'(I8,''>'',I8)') NQREF,NQLINK
          CALL DZTEXT(MSNA4Q,CDUMMQ,0)
          IF (IFLOPT(MPOSSQ).NE.0)                         GO TO 998
      ENDIF

      IF(LQSTA(KQT+2)-LQEND(KQT+1).LT.NQMINR)      THEN
          WRITE (CQINFO,'(I8,''-'',I8,''<'',I8)')
     X     LQSTA(KQT+2),LQEND(KQT+1),NQMINR
          CALL DZTEXT(MSNA5Q,CDUMMQ,0)
          IF (IFLOPT(MPOSSQ).NE.0)                         GO TO 998
      ENDIF

      IF(NQMINR.GT.LQ2END)             THEN
          WRITE (CQINFO,'(I8,''>'',I8)') NQMINR,LQ2END
          CALL DZTEXT(MSNA6Q,CDUMMQ,0)
          IF (IFLOPT(MPOSSQ).NE.0)                         GO TO 998
      ENDIF

      IF(LQ2END.GT.LQSTA(KQT+21))      THEN
          WRITE (CQINFO,'(I8,''>'',I8)') LQ2END,LQSTA(KQT+21)
          CALL DZTEXT(MSNA7Q,CDUMMQ,0)
          IF (IFLOPT(MPOSSQ).NE.0)                         GO TO 998
      ENDIF


      IF (IFLOPT(MPOSTQ).NE.0)         THEN
          IFLOPT(MPOSCQ) = 1
          CALL UCOPY(IFLOPT,IQUEST(71),26)
          CALL VZERO(IFLOPT,26)
          IFLOPT(MPOSNQ) = 1
          IFLOPT(MPOSQQ) = 1
          IFLOPT(MPOSTQ) = 1
          CALL DZARE1('DZSNAP  L option',' ',0,'NQT')
          CALL UCOPY(IQUEST(71),IFLOPT,26)
      ENDIF
      IF (IFLOPT(MPOSLQ).NE.0) THEN
          CALL UCOPY(IFLOPT,IQUEST(71),26)
          CALL VZERO(IFLOPT,26)
          IFLOPT(MPOSNQ) = 1
          CALL DZARE1('DZSNAP  L option',' ',0,'N')
          CALL UCOPY(IQUEST(71),IFLOPT,26)
      ENDIF
      IF (IFLOPT(MPOSWQ).NE.0)               THEN
          CQMAP(1) = ' '
#if !defined(CERNLIB_OCTMAP)
          WRITE(CQMAP(2),'(''  WORKING SPACE   ADR(LQ(0)) = '',Z8)')
#endif
#if defined(CERNLIB_OCTMAP)
          WRITE(CQMAP(2),'(''  WORKING SPACE   ADR(LQ(0)) = '',O8)')
*  Map  addresses expressed in machine words
#endif
#if defined(CERNLIB_WORDMAP)
     W      LQSTOR+1
*  Map addresses expressed in bytes
#endif
#if !defined(CERNLIB_WORDMAP)
     W      (LQSTOR+1)*4
#endif
          CALL DZTEXT(0,CDUMMQ,2)
          LBASE  = 0
          IBASE  = 0
          JDFD   = NQLINK + 1
          NDW    = LQSTA(KQT+1) - 1
          IF (IFLOPT(MPOSTQ).NE.0) THEN
              NDW = MIN(NDW,NQWCUT+NQLINK)
          ELSE
              NDW = MIN(NDW,NQLINK)
          ENDIF
          CALL DZDATA(CDUMMQ)
      ENDIF


      IF (JBYT(IXDIV,1,JSTIDQ-1).EQ.0)  THEN
          JJDIV = MZIXCO(IXDIV+21,IXDIV+22,0,0)
          JJDIV = MZDVAC(JJDIV)
      ELSE
          JJDIV  = MZDVAC (IXDIV)
      ENDIF

      IF (IFLOPT(MPOSEQ)+IFLOPT(MPOSFQ)+IFLOPT(MPOSMQ).EQ.0) GO TO 999



      NDZRSV = 0
      CALL DZBKUP(0)
      IF (IQUEST(1).NE.0)                                  GO TO 999

      DO 1000 JDIVI = 1,NDVMXQ
          IF ( JDIVI.GT.JQDVLL.AND.JDIVI.LT.JQDVSY)        GO TO 1000
          IF (JBIT(JJDIV,JDIVI).EQ.0)                      GO TO 1000
          WRITE(CQMAP,'(1X,/,
     W       '' DZSNAP.   -----  Store nb.'',I2,'' = '',2A4,
     W       '' Division nb.'',I2,'' = '',2A4,20X,20(''-''),/)')
     W      JQSTOR,NQSNAM(1),  NQSNAM(2),
     W      JDIVI,IQDN1(KQT+JDIVI),IQDN2(KQT+JDIVI)
          CALL DZTEXT(0,CDUMMQ,3)
          LN     = LQSTA(KQT+JDIVI)
          LSTOP  = LQEND(KQT+JDIVI)
          IF(LN.EQ.LSTOP)                  THEN
              CQLINE = '          -- Division contains no banks --'
              CALL DZTEXT(0,CDUMMQ,1)
                                                           GO TO 1000
          ENDIF



          JQDIVI = JDIVI
          CALL DZBKXR(0)
          IF (IQUEST(1).NE.0)                              GO TO 999

  300     IF(LN.LT.LSTOP)                  THEN
              CALL DZMAP
              IF (IQUEST(1).NE.0)                          GO TO 400
              LN  = LX
                                                           GO TO 300
          ENDIF

                                                           GO TO 1000
  400     WRITE(CQINFO,'(I8)') LN
          CALL DZTEXT(MSNA8Q,CDUMMQ,0)
          LBKCL= LN
          IFLOPT(MPOSWQ) = -1
  500     LBK = LN
  600     LBK = LBK + 1
          IF (LBK.GE.LSTOP)                THEN
              LN     = LSTOP
              LBASE  = LBKCL-1
              IBASE  = LBASE
              NDW    = MIN(LN - LBKCL,NQWCUT)
              JDFD   = 1
              CALL DZDATA(CDUMMQ)
                                                           GO TO 1000
          ENDIF
          CALL MZCHLN (NCHEKQ,LBK)
          IF (IQFOUL.NE.0)                                 GO TO 600
          LN     = LBK
          LBK    = IQNX
          IF (LBK.GE.LSTOP)                THEN
              LN     = LSTOP
              LBASE  = LBKCL-1
              IBASE  = LBASE
              NDW    = MIN(LN - LBKCL,NQWCUT)
              JDFD   = 1
              CALL DZDATA(CDUMMQ)
                                                           GO TO 1000
          ENDIF
          CALL MZCHLN (NCHEKQ,LBK)
          IF (IQFOUL.NE.0)                                 GO TO 500
  700     CONTINUE
              LBASE  = LBKCL-1
              IBASE  = LBASE
              NDW    = MIN(LN - LBKCL,NQWCUT)
              JDFD   = 1
              CALL DZDATA(CDUMMQ)
          WRITE(CQMAP,'(1X,/,'' RECOVER AT ADR'',I8)')   LN
          CALL DZTEXT(0,CDUMMQ,2)
          IQUEST(1) = 0
                                                           GO TO 300

 1000 CONTINUE

                                                           GO TO 999

  998 IQUEST(1) = 1

  999 RETURN
      END
